-[ c library "interp.c", header "interp.h" ]

-[ headers, begin ]
	!stdlib  !stdarg extlibs parse type pfunc !string
-[end]

-[public] void interp_run(codelist_t *L) {
	-[ list>for C ∈ *L, begin ]
		run_code(C);
	-[ end ]
}

-[private] void run_code(code_t *C) {
	type_t *T1, *T2;
	void *V1, *V2;
	int a,b,c;

	switch(C->kind) {
	case code_store:
		T1= interp_get_type(&C->args[1]);
		V1= interp_get_value(&C->args[1]);
		if (!V1) 
			print_error_exit("uninitialized value in "
				"assignment\n");
		interp_set(&C->args[0], T1,V1);
		break;
	case code_add:
		T1= interp_get_type(&C->args[1]);
		T2= interp_get_type(&C->args[2]);
		if (T1->kind != type_basic || T2->kind!=type_basic) 
			print_error_exit("incompatible arguments to "
				"addition\n");
		if (T1->basic.basic!=basic_int
				|| T2->basic.basic!=basic_int)
			print_error_exit("incompatible arguments to "
				"addition\n");
		V1= interp_get_value(&C->args[1]);
		V2= interp_get_value(&C->args[2]);
		if (!V1 || !V2) 
			print_error_exit("uninitialized value in addition\n");
		b= *(int*) V1;
		c= *(int*) V2;
		a= b+c;
		interp_set(&C->args[0], T1,  &a);
		break;
	case code_mul:
		T1= interp_get_type(&C->args[1]);
		T2= interp_get_type(&C->args[2]);
		if (T1->kind != type_basic || T2->kind!=type_basic) 
			print_error_exit("incompatible arguments to "
				"multiplication\n");
		if (T1->basic.basic!=basic_int
				|| T2->basic.basic!=basic_int)
			print_error_exit("incompatible arguments to "
				"multiplication\n");
		V1= interp_get_value(&C->args[1]);
		V2= interp_get_value(&C->args[2]);
		if (!V1 || !V2) 
			print_error_exit("uninitialized value in "
			"multiplication\n");
		b= *(int*) V1;
		c= *(int*) V2;
		a= b*c;
		interp_set(&C->args[0],T1,&a);
		break;
	case code_sub:
		T1= interp_get_type(&C->args[1]);
		T2= interp_get_type(&C->args[2]);
		if (T1->kind != type_basic || T2->kind!=type_basic) 
			print_error_exit("incompatible arguments to "
				"subtraction\n");
		if (T1->basic.basic!=basic_int
				|| T2->basic.basic!=basic_int)
			print_error_exit("incompatible arguments to "
				"subtraction\n");
		V1= interp_get_value(&C->args[1]);
		V2= interp_get_value(&C->args[2]);
		if (!V1 || !V2) 
			print_error_exit("uninitialized value in "
				"subtraction\n");
		b= *(int*) V1;
		c= *(int*) V2;
		a= b-c;
		interp_set(&C->args[0], T1,  &a);
		break;
	default:
		print_error_exit("code %d is not implemented yet\n",
				C->kind);
	}
}

-[public] void interp_set(carg_t *dst,type_t *T, void *value) 
{
	switch(dst->kind) {
	case carg_varref:
		interp_set_var(dst->d.varref,T,value);
		break;
	default:
		print_error_exit("target of _store should be a "
			"LHS expression\n");
	}
}


/* FIXME: do a proper type compatibility check here */
-[private] void interp_set_var
	(variable_t *var,type_t *type, void *value) 
{
	int size;
	if (!types_equal(var->type, type))
		print_error_exit("incompatible types in "
			"assignment\n");
	size= sizeof_type(type);
	if (!var->value)
		var->value= malloc(size);
	memcpy(var->value, value, size);
}

-[private] type_t* interp_get_type(carg_t *A) {
	type_t *T;
	switch(A->kind) {
	case carg_varref:
		return A->d.varref->type;
	case carg_intconst:
		-[ allocate object T ]
		T->kind= type_basic;
		T->basic.basic= basic_int;
		return T;
	case carg_funcref:
		print_error_exit("funcrefs not completely implemented "
			"yet\n");
	}
	print_error_exit("unknown source type in "
		"interp_get_type\n");
	return 0;
}


-[private] void* interp_get_value(carg_t *A) {
	switch(A->kind) {
	case carg_varref:
		return A->d.varref->value;
	case carg_intconst:
		return &A->d.intconst;
	case carg_funcref:
		print_error_exit("funcrefs not completely implemented "
			"yet\n");
	}
	print_error_exit("unknown source type in "
		"interp_get_value\n");
	return 0;
}

